home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / opl.mod (.txt) < prev    next >
Oberon Text  |  1996-06-06  |  48KB  |  1,349 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE OPL;
  5. (* Code emitter for MC68020.
  6.  Diplomarbeit Samuel Urech
  7.  Date: 04.11.92   Current version: 23.2.93
  8.  changes in red and blue by Ralf Degner 22.5.1995
  9.  020 specific code: Trapcc and many more
  10.  bugfix for Move(): "CLR.X aY" not supported by 68020, OJ 16.5.96
  11.  IMPORT OPT, OPM, SYSTEM;
  12.  CONST
  13.   NewLabel* = 0;
  14.   (* item modes *)
  15.   dreg = 0; areg = 1; freg = 2; postinc = 3; predec = 4; regx = 5; abs = 7; imm = 8; immL = 9; pcx = 10; coc = 12; fcoc = 13;
  16.   (* object modes *)
  17.   Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  18.   SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  19.   (* module visibility of objects *)
  20.   internal = 0; external = 1; externalR = 2;
  21.   (* instruction formats *)
  22.   noext = 0; briefext = 1; fullext = 2; wordDispl = 3; longDispl = 4; extern = 5;
  23.   (* sizes *)
  24.   byte = 0; word = 1; long = 2;
  25.   CP =  0F200H; (* Coprocessor word *)
  26.   DIVS = 81C0H; DIVU = 80C0H; MULS = 0C1C0H; MULU = 0C0C0H;
  27.   (* Condition Codes *)
  28.   CC = 4; CS = 5; EQ = 7; false = 1; GE = 12; GT = 14; HI = 2; LE = 15;
  29.   LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; true = 0; VC = 8; VS = 9;
  30.   (* Floating Point Condition Codes *)
  31.   FEQ = 1; FNE = 0EH; FGT = 12H; FNGT = 1DH; FGE = 13H; FNGE = 1CH; FLT = 14H; FNLT = 1BH; FLE = 15H;
  32.   FNLE = 1AH; Ffalse = 0; Ftrue = 0FH;
  33.   (* Floating Point Control Registers *)
  34.   FPCR = 4; FPSR = 2; FPIAR = 1;
  35.   (* structure forms *)
  36.   Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  37.   Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  38.   Pointer = 13; ProcTyp = 14; Comp = 15;
  39.   (* composite structure forms *)
  40.   Basic = 1; Array = 2; DynArr = 3; Record = 4;
  41.   IntSet = { SInt .. LInt };
  42.   RealSet = { Real, LReal };
  43.   ByteSet = { SInt, Byte, Char, Bool };
  44.   WordSet = { Int };
  45.   LongSet = { LInt, Set, Pointer, ProcTyp };
  46.   None = -1; (* no index or offset register *)
  47.   (* Implementation restrictions *)
  48.   CodeLength = 65535; (* code size in bytes *)
  49.   ConstSize* = 10000; (* constant size *)
  50.   MaxEntry* = 256; (* maximum number of entries *)
  51.   MaxPtrs = 256; (* maximum number of global pointers, old 128 *)
  52.   MaxComs = 60; (* maximum number of commands, old 40 *)
  53.   MaxExts* = 7; (* maximum number of extensions of a record type *)
  54.   (* Offsets in type descriptor *)
  55.   BaseTypeOffs* = 40;
  56.   PtrTabOffs = BaseTypeOffs + 4 * ( MaxExts + 1 );
  57.   MethodOffs* = -4;
  58.  TYPE Label* = LONGINT;
  59.    Item* = RECORD
  60.     mode* : INTEGER; (* dreg, areg, freg, postinc, predec, regx, abs, imm, immL, pcx, coc, fcoc *)
  61.     typ* : OPT.Struct;
  62.     reg* : INTEGER; (* D0 .. D7: 0 .. 7, A0 .. A7: 8 .. 15, FP0 .. FP7: 16 .. 23 *)
  63.     bd* : LONGINT;
  64.     inxReg* : INTEGER; (* None = -1, D0 .. D7: 0 .. 7 *)
  65.     xsize* : INTEGER; (* word: 0; long: 1 *)
  66.     scale* : INTEGER; (* 0, 1, 2, 3 for sizes 1, 2, 4, 8 bytes *)
  67.     tJump*, fJump* : Label; (* for coc- and fcoc-items only *)
  68.     offsReg* : INTEGER; (* for multidimensional dynamic arrays only *)
  69.     nolen* : INTEGER; (* pointer to dynamic array: number of lengths; string: length; 0 otherwise *)
  70.    END; (* Item *)
  71. (* Items:
  72. mode       |  bd          reg     inxReg     xsize     scale    tJump    fJump
  73. ------------------------------------------------------------------------------
  74. dreg       |              reg                                                  (0 .. 7)
  75. areg       |              reg                                                  (8 .. 15)
  76. freg       |              reg                                                  (16 .. 23)
  77. postinc    |              reg
  78. predec     |              reg
  79. regx       |  bd          reg     inxReg     xsize     scale
  80. abs        |  mno/eno
  81. imm, immL  |  val
  82. pcx        |  bd                  inxReg     xsize     scale
  83. coc        |  t/fcond                                           tJump    fJump
  84. fcoc       |  t/fcond                                           tJump    fJump
  85.  VAR code : ARRAY CodeLength OF CHAR; (* generated code *)
  86.    constant : ARRAY ConstSize OF SYSTEM.BYTE; (* constants *)
  87.    entry* : ARRAY MaxEntry OF LONGINT; (* displacements of the exported objects or type descriptor address *)
  88.    pc* : LONGINT;
  89.    link* : INTEGER; (* root of fixup chain *)
  90.    entno* : INTEGER; (* number of exported objects *)
  91.    conx : LONGINT; (* index to the constant array *)
  92.    nofrec : INTEGER; (* number of type descriptors *)
  93.    dsize* : LONGINT; (* size of the global variables *)
  94.    level* : SHORTINT; (* nesting level *)
  95.    usedRegs* : SET; (* used registers: data registers: 0..7, address registers: 8..15, floating point registers: 16..23 *)
  96.    LastSubBegin, LastSubEnd, SubWert : LONGINT;
  97.  PROCEDURE Init*( opt : SET );
  98.  BEGIN (* Init *)
  99.   pc := 0;
  100.   entno := 1; (* for module entry *)
  101.   conx := ConstSize;
  102.   nofrec := 0;
  103.   dsize := 0;
  104.   level := 0;
  105.   usedRegs := {};
  106.   link := 0
  107.  END Init;
  108.  PROCEDURE BegStat*;
  109.  (* Frees all registers. Should be called at the beginning of a statement. *)
  110.  BEGIN (* BegStat *)
  111.   usedRegs := { }
  112.  END BegStat;
  113.  PROCEDURE PutByte( x : LONGINT );
  114.  (* Writes a byte to the code and increments the PC. *)
  115.  BEGIN (* PutByte *)
  116.   IF pc >= CodeLength THEN
  117.    OPM.err( 210 )
  118.   ELSE
  119.    code[ pc ] := CHR( x );
  120.    INC( pc )
  121.   END; (* IF *)
  122.  END PutByte;
  123.  PROCEDURE PutWord( x : LONGINT );
  124.  (* Writes a word to the code and increments the PC by 2. *)
  125.  BEGIN
  126.   PutByte( x DIV 100H );
  127.   PutByte( x MOD 100H )
  128.  END PutWord;
  129.  PROCEDURE PutLongWord( x : LONGINT );
  130.  (* Writes a longword to the code and increments the PC by 4. *)
  131.  BEGIN
  132.   PutWord( x DIV 10000H );
  133.   PutWord( x MOD 10000H )
  134.  END PutLongWord;
  135.  PROCEDURE ConstWord*( pos : INTEGER; val : LONGINT );
  136.  (* Puts the word val at position pos into the constant area. *)
  137.  BEGIN (* ConstWord *)
  138.   constant[ pos ] := CHR( val DIV 100H );
  139.   constant[ pos + 1 ] := CHR( val )
  140.  END ConstWord;
  141.  PROCEDURE PatchWord( pos, val : LONGINT );
  142.  (* Patches the value val at position pos in the code. *)
  143.  BEGIN (* PatchWord *)
  144.   code[ pos ] := CHR( val DIV 100H );
  145.   code[ pos + 1 ] := CHR( val )
  146.  END PatchWord;
  147.  PROCEDURE SetEntry*( pos : INTEGER; val : LONGINT );
  148.  (* Sets entry[ pos ] to the given value. *)
  149.  BEGIN (* SetEntry *)
  150.   entry[ pos ] := val
  151.  END SetEntry;
  152.  PROCEDURE DispSize( disp : LONGINT ) : INTEGER;
  153.  (* Returns a code for the size of a displacement. This code is used in the extension word.
  154.    0         --> 1
  155.    16 Bit --> 2
  156.    32 Bit --> 3 *)
  157.  BEGIN (* DispSize *)
  158.   IF disp = 0 THEN RETURN 1
  159.   ELSIF ( disp >= MIN( INTEGER ) ) & ( disp <= MAX( INTEGER ) ) THEN RETURN 2
  160.   ELSE RETURN 3
  161.   END
  162.  END DispSize;
  163.  PROCEDURE Trapcc*( condition, trapnr : INTEGER );
  164.  (* Writes the code for TRAPcc. *)
  165.  BEGIN (* Trapcc *)
  166.   PutWord( 50FAH + SYSTEM.LSH( condition, 8 ) );
  167.   PutWord( trapnr )
  168.  END Trapcc;
  169.  PROCEDURE LengthCode( size : LONGINT ) : INTEGER;
  170.  (* Returns the size code that is used in the instruction. *)
  171.  BEGIN (* LengthCode *)
  172.   CASE size OF
  173.    1 : RETURN byte
  174.    | 2 : RETURN word
  175.    | 4 : RETURN long
  176.   END; (* CASE *)
  177.  END LengthCode;
  178.  PROCEDURE FloatFormat( typ : OPT.Struct ) : INTEGER;
  179.  (* Returns the code that is filled into the source specifier field of a floating point instruction. *)
  180.  BEGIN (* FloatFormat *)
  181.   IF typ.form IN ByteSet THEN RETURN 6
  182.   ELSIF typ.form IN WordSet THEN RETURN 4
  183.   ELSIF typ.form IN LongSet THEN RETURN 0
  184.   ELSIF typ = OPT.realtyp THEN RETURN 1
  185.   ELSIF typ = OPT.lrltyp THEN RETURN 5
  186.   ELSE HALT( 96 )
  187.   END; (* IF *)
  188.  END FloatFormat;
  189.  PROCEDURE Scale*( size : LONGINT ) : INTEGER;
  190.  (* Returns the code for the scale factor of a size. *)
  191.  BEGIN (* Scale *)
  192.   CASE size OF
  193.    1 : RETURN 0
  194.    | 2 : RETURN 1
  195.    | 4 : RETURN 2
  196.    | 8 : RETURN 3
  197.   END; (* CASE *)
  198.  END Scale;
  199.  PROCEDURE FindPtrs*( typ : OPT.Struct; adr : LONGINT; VAR ptrTab : ARRAY OF LONGINT; VAR nofptrs : INTEGER );
  200.  (* Appends the pointer addresses to ptrTab that occur in the given type. nofptrs is incremented accordingly. *)
  201.   VAR fld: OPT.Object;
  202.     btyp : OPT.Struct;
  203.     i, n, s : LONGINT;
  204.  BEGIN (* FindPtrs *)
  205.   IF typ.form = Pointer THEN
  206.    IF nofptrs < LEN( ptrTab ) THEN
  207.        ptrTab[ nofptrs ] := adr
  208.    ELSE
  209.        OPM.Mark(222, 0); nofptrs:=0
  210.    END;
  211.    INC( nofptrs )
  212.   ELSIF typ.comp = Record THEN
  213.    btyp := typ.BaseTyp;
  214.    IF btyp # NIL THEN FindPtrs( btyp, adr, ptrTab, nofptrs ) END;
  215.    fld := typ.link;
  216.    WHILE ( fld # NIL ) & ( fld.mode = Fld ) DO
  217.     IF fld.name # OPM.HdPtrName THEN
  218.      FindPtrs( fld.typ, fld.adr + adr, ptrTab, nofptrs )
  219.     ELSE
  220.      IF nofptrs < LEN( ptrTab ) THEN
  221.          ptrTab[ nofptrs ] := fld.adr + adr
  222.     ELSE
  223.         OPM.Mark(222, 0); nofptrs:=0
  224.     END;
  225.      INC( nofptrs )
  226.     END; (* IF *)
  227.     fld := fld.link
  228.    END; (* IF *)
  229.   ELSIF typ.comp = Array THEN
  230.    btyp := typ.BaseTyp;
  231.    n := typ.n;
  232.    WHILE btyp.comp = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END;
  233.    IF ( btyp.form = Pointer ) OR ( btyp.comp = Record ) THEN
  234.     i := 0; s := btyp.size;
  235.     WHILE i < n DO FindPtrs( btyp, i * s + adr, ptrTab, nofptrs ); INC( i ) END
  236.    END; (* IF *)
  237.   ELSIF typ.comp = DynArr THEN
  238.    FindPtrs( typ.BaseTyp, 0, ptrTab, nofptrs )
  239.   END; (* IF *)
  240.  END FindPtrs;
  241.  PROCEDURE MakeTypDesc( typ : OPT.Struct; offset : LONGINT; VAR typdesc : ARRAY OF CHAR; VAR pos : LONGINT );
  242.  (* Generates a type descriptor. *)
  243.   VAR
  244.     i: INTEGER;
  245.     j: LONGINT;
  246.     nofptrs : INTEGER;
  247.     baseTyp : OPT.Struct;
  248.     tProcTab : ARRAY MaxEntry OF OPT.Object;
  249.     ptrTab : ARRAY 1000 OF LONGINT;
  250.   PROCEDURE FindTProcs( typ : OPT.Struct );
  251.   (* Writes all methods of the given type into tProcTab. *)
  252.    PROCEDURE trav( obj : OPT.Object );
  253.    BEGIN
  254.     IF obj # NIL THEN
  255.      IF obj.mode = TProc THEN tProcTab[ obj.adr DIV 10000H ] := obj END;
  256.      trav(obj.left);
  257.      trav(obj.right)
  258.     END
  259.    END trav;
  260.   BEGIN (* FindTProcs *)
  261.    IF typ.BaseTyp # NIL THEN FindTProcs( typ.BaseTyp ) END;
  262.    trav( typ.link )
  263.   END FindTProcs;
  264.   PROCEDURE SetByte( pos, val : INTEGER );
  265.   (* Sets the byte at offset pos in the type descriptor to value val. *)
  266.   BEGIN (* SetByte *)
  267.    typdesc[ pos + offset ] := CHR( val )
  268.   END SetByte;
  269.   PROCEDURE SetWord( pos, val : INTEGER );
  270.   (* Sets the word at offset pos in the type descriptor to value val. *)
  271.   BEGIN (* SetWord *)
  272.    typdesc[ pos + offset ] := CHR( val DIV 100H );
  273.    typdesc[ pos + offset + 1 ] := CHR( val MOD 100H )
  274.   END SetWord;
  275.   PROCEDURE SetLong( pos : INTEGER; val : LONGINT );
  276.   (* Sets the longword at offset pos in the type descriptor to value val. *)
  277.   BEGIN (* SetLong *)
  278.    SetWord( pos, SHORT( val DIV 10000H ) );
  279.    SetWord( pos + 2, SHORT( val MOD 10000H ) )
  280.   END SetLong;
  281.   PROCEDURE Set24( pos : INTEGER; VAR name : ARRAY OF CHAR );
  282.   (* Sets the next 24 Bytes at offset pos in the type descriptor to name. *)
  283.    VAR i : INTEGER;
  284.   BEGIN (* Set24 *)
  285.    i := 0;
  286.    WHILE ( i < 24 ) & ( i < LEN( name ) ) DO
  287.     typdesc[ pos + offset + i ] := name[ i ];
  288.     INC( i )
  289.    END; (* WHILE *)
  290.   END Set24;
  291.  BEGIN (* MakeTypDesc *)
  292.   FOR j := 0 TO LEN( typdesc ) - 1 DO typdesc[ j ] := 0X END;
  293.   SetLong( 0, typ.size );
  294.   SetWord( 4, typ.extlev );
  295.   SetWord( 6, SHORT( typ.n ) );
  296.   IF typ.strobj # NIL THEN
  297.    Set24( 16, typ.strobj.name )
  298.   END; (* IF *)
  299.   SetByte( BaseTypeOffs + 4 * typ.extlev + 2, typ.mno );
  300.   SetByte( BaseTypeOffs + 4 * typ.extlev + 3, entno );
  301.   baseTyp := typ.BaseTyp;
  302.   WHILE baseTyp # NIL DO
  303.    SetByte( BaseTypeOffs + 4 * baseTyp.extlev + 2, baseTyp.mno );
  304.    SetByte( BaseTypeOffs + 4 * baseTyp.extlev + 3, SHORT( baseTyp.tdadr ) );
  305.    baseTyp := baseTyp.BaseTyp
  306.   END; (* WHILE *)
  307.   nofptrs := 0;
  308.   FindPtrs( typ, 0, ptrTab, nofptrs );
  309.   FOR i := 0 TO nofptrs - 1 DO SetLong( PtrTabOffs + 4 * i, ptrTab[ i ] ) END;
  310.   SetLong( PtrTabOffs + 4 * nofptrs, -( PtrTabOffs + 4 * nofptrs ) );
  311.   FindTProcs( typ );
  312.   FOR i := 0 TO SHORT(typ.n) - 1 DO
  313.    SetByte( MethodOffs - 4 * ( i + 1 ) + 2, -tProcTab[ i ].mnolev );
  314.    SetByte( MethodOffs - 4 * ( i + 1 ) + 3, SHORT( tProcTab[ i ].adr MOD 100H ) )
  315.   END; (* FOR *)
  316.   pos := PtrTabOffs + 4 * nofptrs + 4
  317.  END MakeTypDesc;
  318.  PROCEDURE AllocBytes*( VAR s : ARRAY OF SYSTEM.BYTE; len : LONGINT; VAR adr : LONGINT );
  319.  (* Allocates s of length len in the constant area with alignment on 8 bytes. adr returns the new address. *)
  320.   VAR align : LONGINT;
  321.  BEGIN (* AllocBytes *)
  322.   align := ( -len ) MOD 8;
  323.   WHILE ( align > 0 ) & ( conx > 0 ) DO
  324.    DEC( conx );
  325.    constant[ conx ] := 0X;
  326.    DEC( align )
  327.   END; (* WHILE *)
  328.   WHILE ( len > 0 ) & ( conx > 0 ) DO
  329.    DEC( conx );
  330.    DEC( len );
  331.    constant[ conx ] := s[ len ]
  332.   END; (* WHILE *)
  333.   adr := conx;
  334.   IF len > 0 THEN
  335.    OPM.err( 230 )
  336.   END; (* IF *)
  337.  END AllocBytes;
  338.  PROCEDURE AllocTypDesc*( typ : OPT.Struct );
  339.  (* Allocates a type descriptor in the constant area. *)
  340.   VAR typdesc : ARRAY 1000 OF CHAR;
  341.     adr, pos, neg : LONGINT;
  342.  BEGIN (* AllocTypDesc *)
  343.   IF ( typ.comp = Record ) & ( typ.tdadr = OPM.TDAdrUndef ) THEN
  344.    neg := -MethodOffs + 4 * typ.n;
  345.    INC( neg, ( -neg ) MOD 8 );
  346.    MakeTypDesc( typ, neg, typdesc, pos );
  347.    INC( pos, ( -pos ) MOD 8 ); (* alignment to 8 because of the Garbage Collector *)
  348.    AllocBytes( typdesc, pos + neg, adr );
  349.    SetEntry( entno, adr - ConstSize - dsize + neg );
  350.    typ.tdadr := entno;
  351.    INC( entno );
  352.    IF typ.extlev > MaxExts THEN OPM.err( 233 )
  353.    ELSE INC( nofrec )
  354.    END; (* IF *)
  355.   END; (* IF *)
  356.  END AllocTypDesc;
  357.  PROCEDURE AllocConst*( obj : OPT.Object; typ : OPT.Struct; VAR bytes : ARRAY OF SYSTEM.BYTE; len : LONGINT;
  358.            VAR item : Item );
  359.  (* Allocates a constant in the constant area if necessary and returns an item describing it. *)
  360.   VAR adr : LONGINT;
  361.  BEGIN (* AllocConst *)
  362.   IF obj = NIL THEN (* no name constant *)
  363.    AllocBytes( bytes, len, adr );
  364.    item.mode := pcx;
  365.    item.inxReg := None;
  366.    item.bd := adr - ConstSize - dsize
  367.   ELSIF obj.conval.intval = OPM.ConstNotAlloc THEN (* named constant not yet allocated *)
  368.    AllocBytes( bytes, len, adr );
  369.    item.mode := pcx;
  370.    item.inxReg := None;
  371.    item.bd := adr - ConstSize - dsize;
  372.    obj.conval.intval := item.bd
  373.   ELSE (* named allocated constant *)
  374.    item.mode := pcx;
  375.    item.inxReg := None;
  376.    item.bd := obj.conval.intval
  377.   END; (* IF *)
  378.   item.typ := typ
  379.  END AllocConst;
  380.  PROCEDURE DefineLabel*( VAR label : Label );
  381.  (* Defines a label and solves its fixup chain if necessary. *)
  382.   VAR next : Label;
  383.     disp : LONGINT;
  384.  BEGIN (* DefineLabel *)
  385.   IF label > 0 THEN HALT( 97 ) END;
  386.   LastSubEnd:=0;
  387.   label := -label;
  388.   WHILE label # NewLabel DO (* solve fixup chain *)
  389.    next := 2 * ( 100H * LONG( ORD( code[ label ] ) ) + LONG( ORD( code[ label + 1 ] ) ) );
  390.    disp := pc - label;
  391.    IF ( disp < MIN( INTEGER ) ) OR ( disp > MAX( INTEGER ) ) THEN
  392.     OPM.err( 211 )
  393.    END;
  394.    PatchWord( label, disp );
  395.    label := next
  396.   END; (* WHILE *)
  397.   label := pc
  398.  END DefineLabel;
  399.  PROCEDURE MergedLinks*( l0, l1 : Label ) : Label;
  400.  (* Merges the fixup chains of the two labels. *)
  401.   VAR cur, next : Label;
  402.  BEGIN (* MergedLinks *)
  403.   IF l0 < 0 THEN
  404.    cur := -l0;
  405.    LOOP
  406.     next := 2 * ( 100H * LONG( ORD( code[ cur ] ) ) + LONG( ORD( code[ cur + 1 ] ) ) );
  407.     IF next = NewLabel THEN EXIT END;
  408.     cur := next
  409.    END; (* LOOP *)
  410.    PatchWord( cur, -l1 DIV 2 );
  411.    RETURN l0
  412.   ELSE RETURN l1
  413.   END; (* IF *)
  414.  END MergedLinks;
  415.  PROCEDURE Jump*( condition : INTEGER; VAR label : Label );
  416.  (* Generates code for a conditional branch to the given label. If the label is not yet defined, the fixup chain is appended. *)
  417.   VAR disp : LONGINT;
  418.  BEGIN (* Jump *)
  419.   IF label > 0 THEN (* label defined*)
  420.    disp := label - pc - 2;
  421.    IF ( disp >= MIN( SHORTINT ) ) & ( disp < MAX( SHORTINT ) ) THEN
  422.     IF disp < 0 THEN INC( disp, 256 ) END;
  423.     PutWord( 6000H + SYSTEM.LSH( condition, 8 ) + disp )
  424.    ELSIF ( disp >= MIN( INTEGER ) ) & ( disp < MAX( INTEGER ) ) THEN
  425.     PutWord( 6000H + SYSTEM.LSH( condition, 8 ) );
  426.     PutWord( disp )
  427.    ELSE
  428.     OPM.err( 211 )
  429.    END; (* IF *)
  430.   ELSE (* label undefined, append fixup chain *)
  431.    PutWord( 6000H + SYSTEM.LSH( condition, 8 ) );
  432.    PutWord( -label DIV 2 );
  433.    label := -( pc - 2 )
  434.   END; (* IF *)
  435.  END Jump;
  436.  PROCEDURE FJump*( condition : INTEGER; VAR label : Label );
  437.  (* Generates code for a conditional branch to the given label. The condition is a floating point condition.
  438.   If the label is not yet defined, the fixup chain is appended. *)
  439.  (* something went wrong with backjumps => problems with REPEAT UNTIL FloadCond *)
  440.   VAR disp : LONGINT;
  441.  BEGIN (* FJump *)
  442.   PutWord( CP + 80H + condition );
  443.   IF label > 0 THEN (* label defined *)
  444.    disp := label - pc - 2 + 2;
  445.    IF DispSize( disp ) = 2 THEN
  446.     PutWord( disp )
  447.    ELSE
  448.     OPM.err( 211 )
  449.    END; (* IF *)
  450.   ELSE (* label undefined, append fixup chain *)
  451.    PutWord( -label DIV 2 );
  452.    label := -( pc - 2 )
  453.   END; (* IF *)
  454.  END FJump;
  455.  PROCEDURE Bsr*( VAR label : Label );
  456.  (* Writes the code for a subroutine call to the given label. If the label is not yet defined, the fixup chain is appended. *)
  457.   VAR disp : LONGINT;
  458.  BEGIN (* Bsr *)
  459.   IF label > 0 THEN (* label defined *)
  460.    disp := label - pc - 2;
  461.    IF ( disp >= MIN( SHORTINT ) ) & ( disp <= MAX( SHORTINT ) ) THEN
  462.     IF disp < 0 THEN INC( disp, 256 ) END;
  463.     PutWord( 6100H + disp )
  464.    ELSIF DispSize( disp ) = 2 (* word *) THEN
  465.     PutWord( 6100H );
  466.     PutWord( disp )
  467.    ELSE (* long *)
  468.     PutWord( 61FFH );
  469.     PutLongWord( disp )
  470.    END; (* IF *)
  471.   ELSE (* label undefined, append fixup chain *)
  472.    PutWord( 6100H );
  473.    PutWord( -label DIV 2 );
  474.    label := -( pc - 2 )
  475.   END; (* IF *)
  476.  END Bsr;
  477.  PROCEDURE Encode( VAR item : Item; VAR mode, reg, extWord, format : INTEGER; VAR bd : LONGINT; offset : INTEGER );
  478.  (* Returns mode, register, extension word and format of an item.
  479.   The following values have to be written to the code:
  480.    format = noext: mode, reg
  481.    format = briefext: mode, reg, extWord
  482.    format = fullext: mode, reg, extWord, bd (if # 0)
  483.    format = wordDispl, longDispl, extern: mode, reg, bd *)
  484.  BEGIN (* Encode *)
  485.   bd := item.bd;
  486.   CASE item.mode OF
  487.    dreg : mode := 0; reg := item.reg; format := noext
  488.    | areg : mode := 1; reg := item.reg - 8; format := noext
  489.    | freg : mode := 0; reg := 0; format := noext
  490.    | postinc : mode := 3; reg := item.reg - 8; format := noext
  491.    | predec : mode := 4; reg := item.reg - 8; format := noext
  492.    | regx :
  493.     IF item.inxReg = None THEN
  494.      CASE DispSize( bd ) OF
  495.       1 :
  496.        mode := 2;
  497.        format := noext
  498.       | 2 :
  499.        mode := 5;
  500.        format := wordDispl
  501.       | 3 :
  502.        mode := 6;
  503.        extWord := 170H;
  504.        format := fullext
  505.      END; (* CASE *)
  506.     ELSE
  507.      mode := 6;
  508.      IF ( bd >= MIN( SHORTINT ) ) & ( bd <= MAX( SHORTINT ) ) THEN
  509.       IF bd < 0 THEN INC( bd, 100H ) END;
  510.       extWord := SYSTEM.LSH( item.inxReg, 12 ) + SYSTEM.LSH( item.xsize, 11 ) + SYSTEM.LSH( item.scale, 9 ) +
  511.            SHORT( bd );
  512.       format := briefext
  513.      ELSE
  514.       extWord := SYSTEM.LSH( item.inxReg, 12 ) + SYSTEM.LSH( item.xsize, 11 ) + SYSTEM.LSH( item.scale, 9 ) +
  515.            SYSTEM.LSH( DispSize( bd ), 4 ) + 100H;
  516.       format := fullext
  517.      END; (* IF *)
  518.     END; (* IF *)
  519.     reg := item.reg - 8
  520.    | abs :
  521.     mode := 7;
  522.     reg := 1;
  523.     format := extern
  524.    | imm :
  525.     mode := 7;
  526.     reg := 4;
  527.     IF item.typ.size = 4 THEN
  528.      format := longDispl
  529.     ELSE
  530.      format := wordDispl
  531.     END; (* IF *)
  532.    | immL :
  533.     mode := 7;
  534.     reg := 4;
  535.     format := extern
  536.    | pcx :
  537.     DEC( bd, pc + offset );
  538.     mode := 7;
  539.     IF item.inxReg = None THEN
  540.      IF DispSize( bd ) < 3 THEN
  541.       reg := 2;
  542.       format := wordDispl
  543.      ELSE
  544.       reg := 3;
  545.       format := fullext;
  546.       extWord := 170H
  547.      END; (* IF *)
  548.     ELSE
  549.      reg := 3;
  550.      IF ( bd >= MIN( SHORTINT ) ) & ( bd <= MAX( SHORTINT ) ) THEN
  551.       IF bd < 0 THEN INC( bd, 100H ) END;
  552.       extWord := SYSTEM.LSH( item.inxReg, 12 ) + SYSTEM.LSH( item.xsize, 11 ) +
  553.            SYSTEM.LSH( item.scale, 9 ) + SHORT( bd );
  554.       format := briefext
  555.      ELSE
  556.       extWord := SYSTEM.LSH( item.inxReg, 12 ) + SYSTEM.LSH( item.xsize, 11 ) +
  557.            SYSTEM.LSH( item.scale, 9 ) + SYSTEM.LSH( DispSize( bd ), 4 ) + 100H;
  558.       format := fullext
  559.      END; (* IF *)
  560.     END; (* IF *)
  561.   END; (* CASE *)
  562.  END Encode;
  563.  PROCEDURE PutExtension( format, extWord : INTEGER; bd : LONGINT );
  564.  (* Writes extensions to the code according to the given format. *)
  565.   VAR val : LONGINT;
  566.  BEGIN (* PutExtension *)
  567.   CASE format OF
  568.    noext : (* nothing *)
  569.    | briefext : PutWord( extWord )
  570.    | fullext :
  571.     PutWord( extWord );
  572.     CASE DispSize( bd ) OF
  573.      1 : (* nothing *)
  574.      | 2 : PutWord( bd )
  575.      | 3 : PutLongWord( bd )
  576.     END
  577.    | wordDispl :
  578.     PutWord( bd )
  579.    | longDispl :
  580.     PutLongWord( bd )
  581.    | extern : (* this was an external reference; link chain has to be appended *)
  582.     val := SYSTEM.LSH( LONG( link ), 16 ) + bd;
  583.     link := SHORT( pc DIV 2 );
  584.     PutLongWord( val )
  585.   END; (* CASE *)
  586.  END PutExtension;
  587.  PROCEDURE GetReg*( ) : INTEGER;
  588.  (* Returns the next free data register. *)
  589.   VAR i : INTEGER;
  590.  BEGIN (* GetReg *)
  591.   i := 0;
  592.   WHILE ( i < 8 ) & ( i IN usedRegs ) DO INC( i ) END;
  593.   IF i = 8 THEN
  594.    OPM.err( 215 )
  595.   END;
  596.   INCL( usedRegs, i );
  597.   RETURN i
  598.  END GetReg;
  599.  PROCEDURE GetAdrReg*( ) : INTEGER;
  600.  (* Returns the next free address register. A6 and A7 are not returned. *)
  601.   VAR i,j : INTEGER;
  602.  BEGIN (* GetAdrReg *)
  603.   i:=8;
  604.   WHILE ( i < 14 ) & ( i IN usedRegs ) DO INC( i ) END;
  605.   IF i = 14 THEN
  606.    OPM.err( 215 )
  607.   END;
  608.   INCL( usedRegs, i );
  609.   RETURN i
  610.  END GetAdrReg;
  611.  PROCEDURE GetFReg*( ) : INTEGER;
  612.  (* Returns the next free floating point register. FP7 is reserved for code procedures. *)
  613.   VAR i : INTEGER;
  614.  BEGIN (* GetFReg *)
  615.   i := 16;
  616.   WHILE ( i < 23 ) & ( i IN usedRegs ) DO INC( i ) END;
  617.   IF i = 23 THEN
  618.    OPM.err( 216 )
  619.   END;
  620.   INCL( usedRegs, i );
  621.   RETURN i
  622.  END GetFReg;
  623.  PROCEDURE FreeReg*( VAR item : Item );
  624.  (* Frees all registers that are used by the item. The item must be defined before and is undefined afterwards. *)
  625.  BEGIN (* FreeReg *)
  626.   IF item.mode IN { dreg, areg, freg, postinc, predec, regx } THEN
  627.    EXCL( usedRegs, item.reg )
  628.   END; (* IF *)
  629.   IF ( item.inxReg # None ) & ( item.mode IN { regx, pcx } ) THEN
  630.    EXCL( usedRegs, item.inxReg )
  631.   END; (* IF *)
  632.  END FreeReg;
  633.  PROCEDURE Lea*( VAR source : Item; destReg : INTEGER );
  634.  (* Writes the code for LEA. *)
  635.   VAR mode, reg, extWord, format : INTEGER;
  636.     bd : LONGINT;
  637.  BEGIN (* Lea *)
  638.   Encode( source, mode, reg, extWord, format, bd, 2 );
  639.   PutWord( 41C0H + SYSTEM.LSH( destReg - 8, 9 ) + SYSTEM.LSH( mode, 3 ) + reg );
  640.   PutExtension( format, extWord, bd )
  641.  END Lea;
  642.  PROCEDURE LoadAdr*( VAR item : Item );
  643.  (* If the item is pc-relative, its address is loaded into an address register. *)
  644.   VAR reg : INTEGER;
  645.  BEGIN (* LoadAdr *)
  646.   IF item.mode = pcx THEN
  647.    reg := GetAdrReg( );
  648.    Lea( item, reg );
  649.    item.mode := regx;
  650.    item.reg := reg;
  651.    item.bd := 0;
  652.    item.inxReg := None;
  653.    item.offsReg := None
  654.   END; (* IF *)
  655.  END LoadAdr;
  656.  PROCEDURE LoadExternal*( VAR item : Item );
  657.  (* If the item is an external reference, its address is loaded into an address register and a regx item is returned. *)
  658.   VAR reg : INTEGER;
  659.  BEGIN (* LoadExternal *)
  660.   IF item.mode = abs THEN
  661.    reg := GetAdrReg( );
  662.    Lea( item, reg );
  663.    item.mode := regx;
  664.    item.reg := reg;
  665.    item.bd := 0;
  666.    item.inxReg := None;
  667.    item.offsReg := None
  668.   END; (* IF *)
  669.  END LoadExternal;
  670.  PROCEDURE Format7*( opcode : LONGINT; VAR dest : Item );
  671.  (* CLR, NEG, NEGX, NOT, TST *)
  672.   VAR mode, reg, extWord, format : INTEGER;
  673.     bd : LONGINT;
  674.  BEGIN (* Format7 *)
  675.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  676.   PutWord( 4000H + SYSTEM.LSH( opcode, 8 ) + SYSTEM.LSH( LengthCode( dest.typ.size ), 6 ) +
  677.      SYSTEM.LSH( mode, 3 ) + reg );
  678.   PutExtension( format, extWord, bd )
  679.  END Format7;
  680.  PROCEDURE Moveq*( val : INTEGER; reg : INTEGER );
  681.  (* Writes the code for MOVEQ.L #val, Dreg *)
  682.  BEGIN (* Moveq *)
  683.   IF val < 0 THEN INC( val, 256 ) END;
  684.   PutWord( 7000H + SYSTEM.LSH( reg, 9 ) + val )
  685.  END Moveq;
  686.  PROCEDURE Move*( VAR source, dest : Item );
  687.  (* Writes the code for MOVE source, dest. Instruction size is source.typ.size. *)
  688.  (* move #0,?? >> clr ?? *)
  689.  (* move.l #b,d? (-127<=b<=127 >> Moveq *)
  690.   VAR sourceMode, sourceReg, sourceExtWord, sourceFormat,
  691.     destMode, destReg, destExtWord, destFormat,
  692.     sizeCode : INTEGER;
  693.     sourcebd, destbd : LONGINT;
  694.  BEGIN (* Move *)
  695.   IF (source.mode=imm) & (source.bd=0) & (dest.mode#pcx) & (dest.mode#areg) THEN        (*<<OJ*)
  696.    Format7(2, dest); (* clr dest *)
  697.   ELSIF (source.mode=imm) & (dest.mode=dreg) & (source.typ.size=4) & (dest.bd<128) & (dest.bd>-128) & (~(dest.mode=pcx)) THEN
  698.    Moveq(SHORT(source.bd), dest.reg)
  699.   ELSE
  700.    CASE LengthCode( source.typ.size ) OF
  701.     byte : sizeCode := 1
  702.     | word : sizeCode := 3
  703.     | long : sizeCode := 2
  704.    END; (* CASE *)
  705.    Encode( dest, destMode, destReg, destExtWord, destFormat, destbd, 0 );
  706.    Encode( source, sourceMode, sourceReg, sourceExtWord, sourceFormat, sourcebd, 2 );
  707.    PutWord( SYSTEM.LSH( sizeCode, 12 ) + SYSTEM.LSH( destReg, 9 ) + SYSTEM.LSH( destMode, 6 ) +
  708.        SYSTEM.LSH( sourceMode, 3 ) + sourceReg );
  709.    PutExtension( sourceFormat, sourceExtWord, sourcebd );
  710.    PutExtension( destFormat, destExtWord, destbd )
  711.   END
  712.  END Move;
  713.  PROCEDURE Movem*( dir, regList : INTEGER; VAR item : Item );
  714.  (* Writes the code for MOVEM.L *)
  715.   VAR mode, reg, extWord, format, OneReg : INTEGER;
  716.     bd : LONGINT;
  717.     source, dest: Item;
  718.   PROCEDURE TestAnz(regs: INTEGER): INTEGER;        (*<<RD*)
  719.       VAR i, erg: INTEGER; 
  720.   BEGIN
  721.       i:=0; erg:=-1;
  722.       LOOP
  723.           IF ODD(regs) THEN
  724.               IF erg#-1 THEN RETURN -1 END;
  725.               erg:=i
  726.           END;
  727.           regs:=regs DIV 2;
  728.           INC(i);
  729.           IF i=16 THEN RETURN erg END;
  730.       END;
  731.   END TestAnz;
  732.  BEGIN (* Movem *)
  733.   OneReg:=TestAnz(regList);        (*<<RD*)
  734.   IF OneReg#-1 THEN    (* only one Reg to move *)
  735.    IF dir=0 THEN
  736.     PutWord( 2F00H + 15 - OneReg)    (* MOVE.L Reg, -(A7) *)
  737.    ELSE
  738.     IF OneReg<8 THEN
  739.      PutWord( 201FH + SYSTEM.LSH(OneReg, 9))    (* MOVE.L (A7)+, Dx *)
  740.     ELSE
  741.      PutWord( 205FH + SYSTEM.LSH(OneReg-8, 9))    (* MOVEA.L (A7)+, Ax *)
  742.     END;
  743.    END;
  744.   ELSE                                    (* >1 Reg to move *)
  745.    Encode( item, mode, reg, extWord, format, bd, 0 );
  746.    PutWord( 48C0H + SYSTEM.LSH( dir, 10 ) + SYSTEM.LSH( mode, 3 ) + reg );
  747.    PutWord( regList );
  748.    PutExtension( format, extWord, bd )
  749.   END
  750.  END Movem;
  751.  PROCEDURE FMove*( VAR source, dest : Item );
  752.  (* Writes the code for FMOVE.size source, dest. Packed Decimal Real is not supported. *)
  753.  (* move from FPReg to FPReg only knows .X and has its own command, real strange bug *)
  754.   VAR mode, reg, extWord, format : INTEGER;
  755.     bd : LONGINT;
  756.  BEGIN (* FMove *)
  757.   IF dest.mode = freg THEN
  758.    IF source.mode = freg THEN
  759.     PutWord( CP);
  760.     PutWord(SYSTEM.LSH(source.reg-16, 10) + SYSTEM.LSH(dest.reg-16, 7))
  761.    ELSE
  762.     Encode( source, mode, reg, extWord, format, bd, 4 );
  763.     PutWord( CP + SYSTEM.LSH( mode, 3 ) + reg );
  764.     PutWord( 4000H + SYSTEM.LSH( FloatFormat( source.typ ), 10 ) + SYSTEM.LSH( dest.reg - 16, 7 ) );
  765.     PutExtension( format, extWord,  bd )
  766.    END
  767.   ELSIF source.mode = freg THEN
  768.    Encode( dest, mode, reg, extWord, format, bd, 0 );
  769.    PutWord( CP + SYSTEM.LSH( mode, 3 ) + reg );
  770.    PutWord( 6000H + SYSTEM.LSH( FloatFormat( source.typ ), 10 ) + SYSTEM.LSH( source.reg - 16, 7 ) );
  771.    PutExtension( format, extWord, bd )
  772.   ELSE
  773.    HALT( 95 )
  774.   END; (* IF *)
  775.  END FMove;
  776.  PROCEDURE FMovecr*( VAR item : Item; dr, controlReg : INTEGER );
  777.  (* Writes the code for FMOVE von oder nach einem Control Register. *)
  778.   VAR mode, reg, extWord, format : INTEGER;
  779.     bd : LONGINT;
  780.  BEGIN (* FMovecr *)
  781.   Encode( item, mode, reg, extWord, format, bd, 4 );
  782.   PutWord( CP + SYSTEM.LSH( mode, 3 ) + reg );
  783.   PutWord( 8000H + SYSTEM.LSH( dr, 13 ) + SYSTEM.LSH( controlReg, 10 ) );
  784.   PutExtension( format, extWord, bd )
  785.  END FMovecr;
  786.  PROCEDURE FMovem*( dir, regList : INTEGER; VAR item : Item );
  787.  (* Writes the code for FMOVEM.X. For (SP)+ and -(SP) only! *)
  788.   VAR mode, reg, extWord, format : INTEGER;
  789.     bd : LONGINT;
  790.  BEGIN (* FMovem *)
  791.   Encode( item, mode, reg, extWord, format, bd, 0 );
  792.   PutWord( CP + SYSTEM.LSH( mode, 3 ) + reg );
  793.   PutWord( 0C000H + SYSTEM.LSH( 1 - dir, 13 ) + SYSTEM.LSH( dir, 12 ) + regList );
  794.   (* without PutExtension! *)
  795.  END FMovem;
  796.  PROCEDURE Load*( VAR item : Item );
  797.  (* Loads the item into a data register. *)
  798.   VAR source : Item;
  799.  BEGIN (* Load *)
  800.   IF item.mode # dreg THEN
  801.    source := item;
  802.    item.mode := dreg;
  803.    item.reg := GetReg( );
  804.    IF source.mode = freg THEN
  805.     FMove( source, item )
  806.    ELSE
  807.     Move( source, item )
  808.    END; (* IF *)
  809.   END; (* IF *)
  810.  END Load;
  811.  PROCEDURE FLoad*( VAR item : Item );
  812.  (* Loads the item into a floating point register. *)
  813.   VAR regItem : Item;
  814.  BEGIN (* FLoad *)
  815.   IF item.mode # freg THEN
  816.    regItem.mode := freg;
  817.    regItem.typ := item.typ;
  818.    regItem.reg := GetFReg( );
  819.    FMove( item, regItem );
  820.    item := regItem
  821.   END; (* IF *)
  822.  END FLoad;
  823.  PROCEDURE AssertDestReg*( typ : OPT.Struct; VAR source, dest : Item );
  824.  (* Makes sure that dest is a register, either by swapping the items or by loading dest. *)
  825.   VAR swap : Item;
  826.  BEGIN (* AssertDestReg *)
  827.   IF ( typ = OPT.realtyp ) OR ( typ = OPT.lrltyp ) THEN
  828.    IF dest.mode # freg THEN
  829.     IF source.mode = freg THEN
  830.      swap := dest;
  831.      dest := source;
  832.      source := swap
  833.     ELSE
  834.      FLoad( dest )
  835.     END; (* IF *)
  836.    END; (* IF *)
  837.   ELSE
  838.    IF dest.mode # dreg THEN
  839.     IF source.mode = dreg THEN
  840.      swap := dest;
  841.      dest := source;
  842.      source := swap
  843.     ELSE
  844.      Load( dest )
  845.     END; (* IF *)
  846.    END; (* IF *)
  847.   END; (* IF *)
  848.  END AssertDestReg;
  849.  PROCEDURE TFConds*( tcond : LONGINT ) : LONGINT;
  850.  (* Converts a condition code to true- and false-conditions. *)
  851.   VAR fcond : INTEGER;
  852.  BEGIN (* TFConds *)
  853.   CASE tcond OF
  854.    CC : fcond := CS
  855.    | CS : fcond := CC
  856.    | EQ : fcond := NE
  857.    | NE : fcond := EQ
  858.    | false : fcond := true
  859.    | true : fcond := false
  860.    | GE : fcond := LT
  861.    | LT : fcond := GE
  862.    | GT : fcond := LE
  863.    | LE : fcond := GT
  864.    | HI : fcond := LS
  865.    | LS : fcond := HI
  866.    | MI : fcond := PL
  867.    | PL : fcond := MI
  868.    | VC : fcond := VS
  869.    | VS : fcond := VC
  870.   END; (* CASE *)
  871.   RETURN 10000H * tcond + fcond
  872.  END TFConds;
  873.  PROCEDURE TFFConds*( tcond : LONGINT ) : LONGINT;
  874.  (* Converts a floating point condition code to true- and false-conditions. *)
  875.   VAR fcond : INTEGER;
  876.  BEGIN (* TFFConds *)
  877.   CASE tcond OF
  878.    FEQ : fcond := FNE
  879.    | FNE : fcond := FEQ
  880.    | FGE : fcond := FNGE
  881.    | FLT : fcond := FNLT
  882.    | FGT : fcond := FNGT
  883.    | FLE : fcond := FNLE
  884.   END; (* CASE *)
  885.   RETURN 10000H * tcond + fcond
  886.  END TFFConds;
  887.  PROCEDURE Chk*( VAR item, chkItem : Item );
  888.  (* Writes the code for CHK. *)
  889.  (* move ??,dx chk dx,dy changed to chk ??,dy *)
  890.   VAR mode, reg, extWord, format, size : INTEGER;
  891.     bd : LONGINT;
  892.  BEGIN (* Chk *)
  893.   IF item.typ = OPT.linttyp THEN
  894.    size := 0
  895.   ELSE
  896.    size := 1
  897.   END;
  898.   Load( item );
  899.   (* Load( chkItem ); *)
  900.   Encode( chkItem, mode, reg, extWord, format, bd, 2 );
  901.   PutWord( 4100H + SYSTEM.LSH( item.reg, 9 ) + SYSTEM.LSH( size, 7 ) + SYSTEM.LSH( mode, 3 ) + reg );
  902.   PutExtension( format, extWord, bd )
  903.  END Chk;
  904.  PROCEDURE DBcc*( condition : INTEGER; VAR reg : INTEGER; VAR label : Label );
  905.  (* Writes the code for DBcc. label must be defined. *)
  906.  BEGIN (* DBcc *)
  907.   PutWord( 50C8H + SYSTEM.LSH( condition, 8 ) + reg );
  908.   PutWord( label - pc )
  909.  END DBcc;
  910.  PROCEDURE Ext*( VAR reg : Item; destSize : INTEGER );
  911.  (* Writes the code for EXT and EXTB. destSize is the desired length code.*)
  912.  BEGIN (* Ext *)
  913.   Load( reg );
  914.   IF reg.typ.size = 1 THEN
  915.    IF destSize = word THEN
  916.     PutWord( 4880H + reg.reg )
  917.    ELSE (* long *)
  918.     PutWord( 49C0H + reg.reg )
  919.    END
  920.   ELSIF reg.typ.size = 2 THEN
  921.    PutWord( 48C0H + reg.reg )
  922.   END; (* IF *)
  923.  END Ext;
  924.  PROCEDURE Divsl*( VAR source, remainder, quotient : Item );
  925.  (* Writes the code for DIVSL.L source, remainder:quotient. *)
  926.   VAR mode, reg, extWord, format : INTEGER;
  927.     bd : LONGINT;
  928.  BEGIN (* Divsl *)
  929.   Load( remainder );
  930.   Load( quotient );
  931.   Encode( source, mode, reg, extWord, format, bd, 4 );
  932.   PutWord( 4C40H + SYSTEM.LSH( mode, 3 ) + reg );
  933.   PutWord( 800H + SYSTEM.LSH( quotient.reg, 12 ) + remainder.reg );
  934.   PutExtension( format, extWord, bd )
  935.  END Divsl;
  936.  PROCEDURE Swap*( VAR dest : Item );
  937.  (* Writes the code for SWAP. *)
  938.  BEGIN (* Swap *)
  939.   Load( dest );
  940.   PutWord( 4840H + dest.reg )
  941.  END Swap;
  942.  PROCEDURE Eor*( VAR source, dest : Item );
  943.  (* Writes the code for EOR source, dest. *)
  944.   VAR mode, reg, extWord, format : INTEGER;
  945.     bd : LONGINT;
  946.  BEGIN (* Eor *)
  947.   Load( source );
  948.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  949.   PutWord( 0B100H + SYSTEM.LSH( source.reg, 9 ) + SYSTEM.LSH( LengthCode( dest.typ.size ), 6 ) +
  950.       SYSTEM.LSH( mode, 3 ) + reg );
  951.   PutExtension( format, extWord, bd )
  952.  END Eor;
  953.  PROCEDURE Enter*( val : LONGINT );
  954.  (* Writes the code for procedure or module entry. *)
  955.  BEGIN
  956.   IF DispSize( val ) = 3 THEN
  957.    PutWord( 480EH );
  958.    PutLongWord( val )
  959.   ELSE
  960.    PutWord( 4E56H );
  961.    PutWord( val )
  962.   END; (* IF *)
  963.  END Enter;
  964.  PROCEDURE Return*;
  965.  (* Writes the code for procedure or module exit. *)
  966.  BEGIN
  967.   PutWord( 4E5EH ); (* UNLK A6 *)
  968.   PutWord( 4E75H ); (* RTS *)
  969.  END Return;
  970.  PROCEDURE WriteCProc*( code : OPT.ConstExt );
  971.  (* Writes the code of a code procedure. *)
  972.   VAR i, n : INTEGER;
  973.  BEGIN (* WriteCProc *)
  974.   n := ORD( code^[ 0 ] );
  975.   FOR i := 1 TO n DO PutByte( ORD( code^[ i ] ) ) END
  976.  END WriteCProc;
  977.  PROCEDURE Format1*( opcode : LONGINT; data : INTEGER; VAR dest : Item );
  978.  (* ADDQ, SUBQ *)
  979.   VAR mode, reg, extWord, format : INTEGER;
  980.     bd : LONGINT;
  981.  BEGIN (* Format1 *)
  982.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  983.   IF data = 8 THEN data := 0 END;
  984.   PutWord( 5000H + SYSTEM.LSH( data, 9 ) + SYSTEM.LSH( opcode, 8 ) + SYSTEM.LSH( LengthCode( dest.typ.size ), 6 ) +
  985.       SYSTEM.LSH( mode, 3 ) + reg );
  986.   PutExtension( format, extWord, bd )
  987.  END Format1;
  988.  PROCEDURE Format6*( opcode : LONGINT; data : LONGINT; VAR dest : Item );
  989.  (* ADDI, ANDI, CMPI, EORI, ORI, SUBI *)
  990.   VAR size, mode, reg, extWord, format : INTEGER;
  991.     bd : LONGINT;
  992.  BEGIN (* Format6 *)
  993.   size := LengthCode( dest.typ.size );
  994.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  995.   PutWord( SYSTEM.LSH( opcode, 8 ) + SYSTEM.LSH( size, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  996.   IF size = long THEN
  997.    PutLongWord( data )
  998.   ELSE
  999.    PutWord( data )
  1000.   END; (* IF *)
  1001.   PutExtension( format, extWord, bd )
  1002.  END Format6;
  1003.  PROCEDURE Format2*( opcode : LONGINT; VAR source, dest : Item );
  1004.  (* ADD, AND, OR, SUB *)
  1005.   VAR mode, reg, extWord, format, size : INTEGER;
  1006.     bd : LONGINT;
  1007.  BEGIN (* Format2 *)
  1008.   size := LengthCode( source.typ.size );
  1009.   IF dest.mode = dreg THEN
  1010.    Encode( source, mode, reg, extWord, format, bd, 2 );
  1011.    PutWord( SYSTEM.LSH( opcode, 12 ) + SYSTEM.LSH( dest.reg, 9 ) + SYSTEM.LSH( size, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1012.    PutExtension( format, extWord, bd )
  1013.   ELSE
  1014.    Load( source );
  1015.    Encode( dest, mode, reg, extWord, format, bd, 0 );
  1016.    PutWord( 100H + SYSTEM.LSH( opcode, 12 ) + SYSTEM.LSH( source.reg, 9 ) + SYSTEM.LSH( size, 6 ) +
  1017.        SYSTEM.LSH( mode, 3 ) + reg );
  1018.    PutExtension( format, extWord, bd )
  1019.   END; (* IF *)
  1020.  END Format2;
  1021.  PROCEDURE Format3*( opcode : LONGINT; VAR source : Item; destReg : INTEGER );
  1022.  (* ADDA, SUBA *)
  1023.  (* uses ADDQ/SUBQ if possible *)
  1024.  (* try to collect ADDA #x,A7 and SUBA #y,A7 *)
  1025.   VAR mode, reg, extWord, format, size : INTEGER;
  1026.     bd : LONGINT;
  1027.     dest: Item;
  1028.     ImmFlag: BOOLEAN;
  1029.  BEGIN (* Format3 *)
  1030.   ImmFlag:=FALSE;
  1031.   IF (source.mode=imm) & (destReg=8+7) THEN
  1032.    ImmFlag:=TRUE;
  1033.    IF (LastSubEnd=pc) THEN
  1034.     pc:=LastSubBegin;
  1035.     IF opcode=13 THEN
  1036.      INC(SubWert, source.bd)
  1037.     ELSE
  1038.      DEC(SubWert, source.bd)
  1039.     END;
  1040.     IF SubWert>0 THEN
  1041.      source.bd:=SubWert;opcode:=13
  1042.     ELSE
  1043.      source.bd:=-SubWert;opcode:=9
  1044.     END
  1045.    ELSE
  1046.     IF opcode=13 THEN
  1047.      SubWert:=source.bd
  1048.     ELSE
  1049.      SubWert:=-source.bd
  1050.     END
  1051.    END;
  1052.    LastSubBegin:=pc
  1053.   END;
  1054.   IF (source.mode=imm) & (~(dest.mode=pcx)) & (source.bd>0) & (source.bd<=16) THEN
  1055.    dest.mode:=areg;dest.reg:=destReg;dest.inxReg:=-1;NEW(dest.typ);dest.typ.size:=source.typ.size;
  1056.    IF (opcode=13) THEN opcode:=0 ELSE opcode:=1 END;
  1057.    IF source.bd>8 THEN
  1058.     Format1(opcode, 8, dest);
  1059.     DEC(source.bd, 8)
  1060.    END;
  1061.    Format1(opcode, SHORT(source.bd), dest)
  1062.   ELSIF ~((source.mode=imm) & (source.bd=0)) THEN
  1063.    IF LengthCode( source.typ.size ) = long THEN
  1064.     size := 1
  1065.    ELSE
  1066.     size := 0
  1067.    END; (* IF *)
  1068.    Encode( source, mode, reg, extWord, format, bd, 2 );
  1069.    PutWord( 0C0H + SYSTEM.LSH( opcode, 12 ) + SYSTEM.LSH( destReg - 8, 9 )+ SYSTEM.LSH( size, 8 ) +
  1070.        SYSTEM.LSH( mode, 3 ) + reg );
  1071.    PutExtension( format, extWord, bd )
  1072.   END;
  1073.   IF ImmFlag THEN
  1074.    LastSubEnd:=pc
  1075.   END
  1076.  END Format3;
  1077.  PROCEDURE Format4*( opcode : LONGINT; bitnr : LONGINT; VAR dest : Item );
  1078.  (* BSET, BCLR, BCHG, BTST, static bit number. *)
  1079.   VAR mode, reg, extWord, format : INTEGER;
  1080.     bd : LONGINT;
  1081.  BEGIN (* Format4 *)
  1082.   Load( dest );
  1083.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  1084.   PutWord( 0800H + SYSTEM.LSH( opcode, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1085.   PutWord( bitnr );
  1086.   PutExtension( format, extWord, bd )
  1087.  END Format4;
  1088.  PROCEDURE Format5*( opcode : LONGINT; VAR bitnr, dest : Item );
  1089.  (* BSET, BCLR, BCHG, BTST, dynamic bit number. *)
  1090.   VAR mode, reg, extWord, format : INTEGER;
  1091.     bd : LONGINT;
  1092.  BEGIN (* Format5 *)
  1093.   Load( bitnr );
  1094.   Load( dest );
  1095.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  1096.   PutWord( 0100H + SYSTEM.LSH( bitnr.reg, 9 ) + SYSTEM.LSH( opcode, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1097.   PutExtension( format, extWord, bd )
  1098.  END Format5;
  1099.  PROCEDURE Format8*( opcode : LONGINT; VAR source, dest : Item );
  1100.  (* Coprocessor operation. *)
  1101.   VAR mode, reg, extWord, format : INTEGER;
  1102.     bd : LONGINT;
  1103.  BEGIN (* Format8 *)
  1104.   FLoad( dest );
  1105.   IF source.mode = freg THEN
  1106.    PutWord( CP );
  1107.    PutWord( SYSTEM.LSH( source.reg - 16, 10 ) + SYSTEM.LSH( dest.reg - 16, 7 ) + opcode )
  1108.   ELSE
  1109.    Encode( source, mode, reg, extWord, format, bd, 4 );
  1110.    PutWord( CP + SYSTEM.LSH( mode, 3 ) + reg );
  1111.    PutWord( 4000H + SYSTEM.LSH( FloatFormat( source.typ ), 10 ) + SYSTEM.LSH( dest.reg - 16, 7 ) + opcode );
  1112.    PutExtension( format, extWord, bd )
  1113.   END; (* IF *)
  1114.  END Format8;
  1115. (* I think, Format9 and Format 10 are never used => no bitfields *)
  1116.  PROCEDURE Format9*( opcode : LONGINT; VAR dest : Item; offset, width : INTEGER );
  1117.  (* BFCHG, BFCLR, BFSET, BFTST, static offset and width. *)
  1118.   VAR mode, reg, extWord, format : INTEGER;
  1119.     bd : LONGINT;
  1120.  BEGIN (* Format9 *)
  1121.   Load( dest );
  1122.   IF width > 0 THEN
  1123.    IF width = 32 THEN width := 0 END;
  1124.    Encode( dest, mode, reg, extWord, format, bd, 0 );
  1125.    PutWord( 0E0C0H + SYSTEM.LSH( opcode, 8 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1126.    PutWord( SYSTEM.LSH( offset, 6 ) + width );
  1127.    PutExtension( format, extWord, bd )
  1128.   END; (* IF *)
  1129.  END Format9;
  1130.  PROCEDURE Format10*( opcode : LONGINT; offset : INTEGER; VAR width, dest : Item );
  1131.  (* BFCHG, BFCLR, BFSET, BFTST, static offset, dynamic width. *)
  1132.   VAR mode, reg, extWord, format : INTEGER;
  1133.     bd : LONGINT;
  1134.  BEGIN (* Format10 *)
  1135.   Load( width );
  1136.   Load( dest );
  1137.   Encode( dest, mode, reg, extWord, format, bd, 0 );
  1138.   PutWord( 0E0C0H + SYSTEM.LSH( opcode, 8 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1139.   PutWord( 20H + SYSTEM.LSH( offset, 6 ) + width.reg );
  1140.   PutExtension( format, extWord, bd )
  1141.  END Format10;
  1142.  PROCEDURE Format11*( opcode : LONGINT; VAR source, dest : Item );
  1143.  (* MULU, MULS, DIVU, DIVS (short form) *)
  1144.   VAR mode, reg, extWord, format : INTEGER;
  1145.     bd : LONGINT;
  1146.  BEGIN (* Format11 *)
  1147.   Load( dest );
  1148.   Encode( source, mode, reg, extWord, format, bd, 2 );
  1149.   PutWord( opcode + SYSTEM.LSH( dest.reg, 9 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1150.   PutExtension( format, extWord, bd )
  1151.  END Format11;
  1152.  PROCEDURE Format12*( opcode : LONGINT; VAR source, dest : Item );
  1153.  (* MULU, MULS, DIVU, DIVS (long form with one result register) *)
  1154.   VAR mode, reg, extWord, format, bit6, bit11 : INTEGER;
  1155.     bd : LONGINT;
  1156.  BEGIN (* Format12 *)
  1157.   IF opcode = MULU THEN bit6 := 0; bit11 := 0
  1158.   ELSIF opcode = MULS THEN bit6 := 0; bit11 := 1
  1159.   ELSIF opcode = DIVU THEN bit6 := 1; bit11 := 0
  1160.   ELSIF opcode = DIVS THEN bit6 := 1; bit11 := 1
  1161.   END; (* IF *)
  1162.   Load( dest );
  1163.   Encode( source, mode, reg, extWord, format, bd, 4 );
  1164.   PutWord( 4C00H + SYSTEM.LSH( bit6, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1165.   PutWord( SYSTEM.LSH( dest.reg, 12 ) + SYSTEM.LSH( bit11, 11 ) + dest.reg );
  1166.   PutExtension( format, extWord, bd )
  1167.  END Format12;
  1168.  PROCEDURE Format13*( opcode, shiftleft : INTEGER; VAR dest : Item );
  1169.  (* ASL, ASR, LSL, LSR, ROL, ROR, ROXL, ROXR, static number of bits. *)
  1170.   VAR dr, size : INTEGER;
  1171.  BEGIN (* Format13 *)
  1172.   size := LengthCode( dest.typ.size );
  1173.   IF shiftleft > 0 THEN dr := 1 ELSE dr := 0 END;
  1174.   IF ABS( shiftleft ) = 8 THEN shiftleft := 0 END;
  1175.   Load( dest );
  1176.   PutWord( 0E000H + SYSTEM.LSH( ABS( shiftleft ), 9 ) + SYSTEM.LSH( dr, 8 ) + SYSTEM.LSH( size, 6 )
  1177.        + SYSTEM.LSH( opcode, 3 ) + dest.reg )
  1178.  END Format13;
  1179.  PROCEDURE Format14*( opcode, dr : INTEGER; VAR shift, dest : Item );
  1180.  (* ASL, ASR, LSL, LSR, ROL, ROR, ROXL, ROXR, dynamic number of bits. *)
  1181.  BEGIN (* Format14 *)
  1182.   Load( shift );
  1183.   Load( dest );
  1184.   PutWord( 0E020H + SYSTEM.LSH( shift.reg, 9 ) + SYSTEM.LSH( dr, 8 ) + SYSTEM.LSH( LengthCode( dest.typ.size ), 6 )
  1185.       + SYSTEM.LSH( opcode, 3 ) + dest.reg )
  1186.  END Format14;
  1187.  PROCEDURE Format15*( opcode : INTEGER; VAR item : Item );
  1188.  (* JMP, JSR, PEA *)
  1189.   VAR mode, reg, extWord, format : INTEGER;
  1190.     bd : LONGINT;
  1191.  BEGIN (* Format15 *)
  1192.   Encode( item, mode, reg, extWord, format, bd, 2 );
  1193.   PutWord( 4000H + SYSTEM.LSH( opcode, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1194.   PutExtension( format, extWord, bd )
  1195.  END Format15;
  1196.  PROCEDURE Cmp*( VAR source, dest : Item );
  1197.  (* Writes the code for CMP source, dest. *)
  1198.  (* cmp #a,?? >> cmpi #a,?? or tst ?? if a=0 *)
  1199.   VAR mode, reg, extWord, format, size : INTEGER;
  1200.     bd : LONGINT;
  1201.  BEGIN (* Cmp *)
  1202.   size:= LengthCode( source.typ.size );
  1203.   IF (source.mode=imm) & (source.bd=0) & (~(dest.mode=pcx)) THEN (* TST *)
  1204.          (*Encode( dest, mode, reg, extWord, format, bd, 2 );
  1205.          PutWord( 4A00H + SYSTEM.LSH( size, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );*)
  1206.    Format7(10, dest)
  1207.   ELSIF (source.mode=imm) & (~(dest.mode=pcx)) THEN (* CMPI *)
  1208.          (*Encode( dest, mode, reg, extWord, format, bd, 6 );
  1209.          PutWord(  0C00H + SYSTEM.LSH( size, 6 ) + SYSTEM.LSH( mode, 3 ) + reg );
  1210.          IF size = long THEN
  1211.           PutLongWord( source.bd )
  1212.          ELSIF size = word THEN
  1213.           PutWord( source.bd )
  1214.          ELSE
  1215.           PutByte( 0);PutByte( source.bd)
  1216.          END; (* IF *)*)
  1217.    Format6(12, source.bd, dest)
  1218.   ELSE
  1219.    Load(dest);
  1220.    Encode( source, mode, reg, extWord, format, bd, 2 );
  1221.    PutWord( 0B000H + SYSTEM.LSH( dest.reg, 9 ) + SYSTEM.LSH( size, 6 ) +
  1222.        SYSTEM.LSH( mode, 3 ) + reg );
  1223.    PutExtension( format, extWord, bd )
  1224.   END
  1225.  END Cmp;
  1226.  PROCEDURE OutRefPoint*;
  1227.  BEGIN (* OutRefPoint *)
  1228.   OPM.RefW( 0F8X );
  1229.   OPM.RefWInt( pc )
  1230.  END OutRefPoint;
  1231.  PROCEDURE OutRefName*( name : ARRAY OF CHAR );
  1232.  (* Writes a name to the reference file. *)
  1233.   VAR ch : CHAR;
  1234.     i : INTEGER;
  1235.  BEGIN (* OutRefName *)
  1236.   i := 0;
  1237.   REPEAT
  1238.    ch := name[ i ];
  1239.    OPM.RefW( ch );
  1240.    INC( i )
  1241.   UNTIL ch = 0X
  1242.  END OutRefName;
  1243.  PROCEDURE OutRefs*( obj : OPT.Object );
  1244.  (* Writes the reference information of the variables. *)
  1245.   VAR f : INTEGER;
  1246.  BEGIN (* OutRefs *)
  1247.   IF obj # NIL THEN
  1248.    OutRefs( obj^.left );
  1249.    IF ( obj^.mode = Var ) OR ( obj^.mode = VarPar ) THEN
  1250.     f := obj^.typ^.form;
  1251.     IF ( f IN { Byte .. Set, Pointer } ) OR ( obj^.typ^.comp = Array ) & ( obj^.typ^.BaseTyp^.form = Char ) THEN
  1252.      IF obj^.mode = Var THEN OPM.RefW( 1X ) ELSE OPM.RefW( 3X ) END;
  1253.      IF obj^.typ^.comp = Array THEN OPM.RefW( 0FX )
  1254.      ELSE OPM.RefW( CHR( f ) )
  1255.      END;
  1256.      OPM.RefWInt( obj^.linkadr );
  1257.      OutRefName( obj^.name )
  1258.     END
  1259.    END;
  1260.    OutRefs(obj^.right)
  1261.   END
  1262.  END OutRefs;
  1263.  PROCEDURE WriteName( VAR name : ARRAY OF CHAR; n : INTEGER );
  1264.  (* Writes name to the object file with at least n characters. *)
  1265.   VAR i : INTEGER; ch : CHAR;
  1266.  BEGIN
  1267.   i := 0;
  1268.   REPEAT
  1269.    ch := name[ i ];
  1270.    OPM.ObjW( ch );
  1271.    INC( i )
  1272.   UNTIL ch = 0X;
  1273.   WHILE i < n DO OPM.ObjW( 0X ); INC( i ) END
  1274.  END WriteName;
  1275.  PROCEDURE OutCode*( VAR modName : ARRAY OF CHAR; key : LONGINT );
  1276.  (* Writes the object file. *)
  1277.   VAR i : LONGINT;
  1278.     nofcom, nofptrs : INTEGER;
  1279.     obj : OPT.Object;
  1280.     comTab : ARRAY MaxComs OF OPT.Object;
  1281.     ptrTab : ARRAY MaxPtrs OF LONGINT;
  1282.   PROCEDURE Traverse( obj : OPT.Object );
  1283.   (* Collects commands in comTab and global pointers in ptrTab. Increments nofcom and nofptrs accordingly. *)
  1284.   BEGIN (* Traverse *)
  1285.    IF obj # NIL THEN
  1286.     IF obj.mode = XProc THEN
  1287.      IF ( obj.vis # internal ) & ( obj.link = NIL ) & ( obj.typ = OPT.notyp ) THEN (* command *)
  1288.       IF nofcom < MaxComs THEN
  1289.        comTab[ nofcom ] := obj;
  1290.        INC(nofcom)
  1291.       ELSE
  1292.        OPM.Mark(232, 0);
  1293.        nofcom := 0
  1294.       END; (* IF *)
  1295.      END; (* IF *)
  1296.     ELSIF ( obj.mode = Var ) & ( obj.linkadr < 0 ) THEN
  1297.      FindPtrs( obj.typ, obj.linkadr, ptrTab, nofptrs )
  1298.     END; (* IF *)
  1299.     Traverse( obj.left );
  1300.     Traverse( obj.right )
  1301.    END; (* IF *)
  1302.   END Traverse;
  1303.  BEGIN (* OutCode *)
  1304.   nofcom := 0;
  1305.   nofptrs := 0;
  1306.   Traverse( OPT.topScope.right );
  1307.  (* header block *)
  1308.   OPM.ObjWInt( entno );
  1309.   OPM.ObjWInt( nofcom );
  1310.   OPM.ObjWInt( nofptrs );
  1311.   OPM.ObjWInt( OPT.nofGmod );
  1312.   OPM.ObjWInt( link );
  1313.   OPM.ObjWLInt( dsize );
  1314.   OPM.ObjWLInt( ConstSize - conx );
  1315.   OPM.ObjWLInt( pc );
  1316.   OPM.ObjWLInt( key );
  1317.   WriteName( modName, 24 );
  1318.  (* entry block *)
  1319.   OPM.ObjW( 82X );
  1320.   FOR i := 0 TO entno - 1 DO OPM.ObjWLInt( entry[ i ] ) END;
  1321.  (* command block *)
  1322.   OPM.ObjW( 83X );
  1323.   FOR i := 0 TO nofcom - 1 DO
  1324.    obj := comTab[ i ];
  1325.    WriteName( obj.name, 0 );
  1326.    OPM.ObjWLInt( entry[ obj.adr ] )
  1327.   END; (* FOR *)
  1328.  (* pointer block *)
  1329.   OPM.ObjW( 84X );
  1330.   FOR i := 0 TO nofptrs - 1 DO OPM.ObjWLInt( ptrTab[ i ] ) END;
  1331.  (* import block *)
  1332.   OPM.ObjW( 85X );
  1333.   FOR i := 0 TO OPT.nofGmod - 1 DO
  1334.    obj := OPT.GlbMod[ i ];
  1335.    OPM.ObjWLInt( obj.adr );
  1336.    WriteName( obj.name, 0 )
  1337.   END; (* FOR *)
  1338.  (* data block *)
  1339.   OPM.ObjW( 86X );
  1340.   FOR i := conx TO ConstSize - 1 DO OPM.ObjW( SYSTEM.VAL( CHAR, constant[ i ] ) ) END;
  1341.  (* code block *)
  1342.   OPM.ObjW( 87X );
  1343.   OPM.ObjWBytes( code, pc );
  1344.  (* ref block written in OPM.CloseRefObj *)
  1345.  END OutCode;
  1346.  PROCEDURE Close*;
  1347.  END Close;
  1348. END OPL.
  1349.